home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 60.zip / BS1 part 60 / Imagemaster d5.adf / piarc.lzh.parta / gif.rexx < prev    next >
OS/2 REXX Batch file  |  1993-04-14  |  5KB  |  208 lines

  1. /* ARexx GIF */
  2. parse arg var1
  3. /*
  4.  * GIF.rexx - GIF image load
  5.  *
  6.  * If you encounter  a .GIF file we do not read, sent it to us (we suggest
  7.  * you use the Black Belt Bulletin Board at 1-406-367 2227) with an
  8.  * explanation and we will endeavor to extend our loader to handle it.
  9.  *
  10.  *  Written by: Black Belt Systems  Technical Development
  11.  * Last Update: March 25th, 1993
  12.  *    Revision: 1.01
  13.  *         For: Black Belt Systems image processing series IM, IM F/c, and IP.
  14.  *
  15.  * Modifications:
  16.  *        1.01  25 Mar 1993  (BC)  Did not report on insufficient memory for
  17.  *                                 new buffer from IM prior to 9.51
  18.  *        1.00  25 Feb 1993  (BC)  Replaces loader inside IM.
  19.  *                                 More robust.
  20.  *                                 Streamlined calling procedure.
  21.  *
  22.  */
  23. call pragma('stack',20000);
  24.  
  25. /*
  26.  * open rexxsupport.library -- needed for some functions
  27.  */
  28. if ~show('L',"rexxsupport.library") then do
  29.   if addlib('rexxsupport.library',0,-30,0) then do
  30.       /* everything's ok */
  31.     end;
  32.   else do
  33.     say 'We Have A Library Problem, Unable To Load "rexxsupport.library"';
  34.     say 'Cannot operate script without this library - sorry!';
  35.     exit 10;
  36.     end;
  37.   end;
  38.  
  39. prtnme = 'IM_Port';
  40. cmdpath = 'cmpi:';
  41.  
  42. /*
  43.  * Get the file name parts
  44.  */
  45.   prevpath = 'ram:';
  46.   if show('C',rawpath) = 1 then do
  47.     prevpath = getclip(rawpath);
  48.     end;
  49.   prevname = 'image';
  50.   if show('C',rawname) = 1 then do
  51.     prevname = getclip(rawname);
  52.     end;
  53.   prevext = '.GIF';
  54.   if show('C',rawext) = 1 then do
  55.     prevext = getclip(rawext);
  56.     end;
  57.  
  58. address(prtnme);
  59. 'autoredraw 0';
  60.  
  61. if var1 = 'load' then do
  62.   loadquestion = 0
  63.   end
  64. else if var1 = 'save' then do
  65.   loadquestion = 1
  66.   end
  67. else do
  68.   options results;
  69.   'gadgets "Load .GIF","Image","Save .GIF","Image"';
  70.   loadquestion = result-1;
  71.   options;
  72.   end
  73.  
  74. if loadquestion < 0 then do
  75.   address(prtnme);
  76.   'tofront';
  77.   exit 0;
  78.   end
  79.  
  80. if loadquestion = 0 then do
  81.   options results;
  82.   'filerequest "'||prevpath||'" "'||prevname||'" "'||prevext||'" '||'"Load .GIF"';
  83.   GIFfile = result;
  84.   options;
  85.   call checkfile(GIFfile);
  86.   end
  87. if loadquestion = 1 then do
  88.   options results;
  89.   'filerequest "'||prevpath||'" "'||prevname||'" "'||prevext||'" '||'"Save .GIF"';
  90.   GIFfile = result;
  91.   options;
  92.   call checkfile(GIFfile);
  93.   
  94.   /* Could put compression question Here !! */
  95.   
  96.   end
  97.     
  98.     options results;
  99.     'jackin';
  100.     jack = result;
  101.     options;
  102.  
  103.     address command cmdpath||'GIF '||jack||' '||loadquestion||' "'||GIFfile||'" '||prevname||' '||compression;
  104.     address(prtnme);
  105.  
  106. 'autoredraw 1';
  107.  
  108. exit 0;
  109.  
  110.  
  111.  
  112.  
  113. checkfile: 
  114. arg thefile;
  115.   if thefile = 'FR_CANCELLED' then do
  116.     address(prtnme);
  117.     'tofront';
  118.     exit 0;
  119.     end;
  120.   prevpath = gimmepath(thefile);
  121.   call setclip(rawpath,prevpath);
  122.   prevname = gimmename(thefile);
  123.   call setclip(rawname,prevname);
  124.   prevext  = gimmeext(thefile);
  125.   call setclip(rawext,prevext);
  126.   return;
  127.   end
  128.  
  129. /*
  130.  * gimmepath
  131.  *
  132.  * This takes the provided argument and sucks the path out of it, then
  133.  * returns that path to the caller, sans file name.
  134.  */
  135. gimmepath:
  136.   arg fullnamegx;
  137.     tempgx = reverse(fullnamegx);
  138.     lengx = length(fullnamegx);   /* get length of string */
  139.     slashdex = index(tempgx,'/'); /* first occurance of '/' from right */
  140.     colondex = index(tempgx,':');  /* first occurance of ':' from right */
  141.     seploc = 0; /* assumes current dir, no path supplied */
  142.     if slashdex ~= 0 then do /* we assume we are in a DIR */
  143.       seploc = (lengx - slashdex)+1;
  144.       end;
  145.     else do
  146.       if colondex ~= 0 then do /* we assume we are on a device */
  147.         seploc = (lengx - colondex)+1;
  148.         end;
  149.       end;
  150.   gxname = substr(fullnamegx,seploc+1); /* if you ever need it */
  151.   gxpath = left(fullnamegx,seploc);
  152.   return(gxpath);
  153.   end
  154.  
  155.  
  156. gimmename:
  157.   arg fullnamegx;
  158.     tempgx = reverse(fullnamegx);
  159.     lengx = length(fullnamegx);   /* get length of string */
  160.     slashdex = index(tempgx,'/'); /* first occurance of '/' from right */
  161.     colondex = index(tempgx,':');  /* first occurance of ':' from right */
  162.     seploc = 0; /* assumes current dir, no path supplied */
  163.     if slashdex ~= 0 then do /* we assume we are in a DIR */
  164.       seploc = (lengx - slashdex)+1;
  165.       end;
  166.     else do
  167.       if colondex ~= 0 then do /* we assume we are on a device */
  168.         seploc = (lengx - colondex)+1;
  169.         end;
  170.       end;
  171.   extpos = lastpos(".",fullnamegx) - 2;
  172.   if extpos > seploc then do
  173.     gxname = substr(fullnamegx,seploc+1,extpos-seploc+1);
  174.     end;
  175.   else do
  176.     gxname = substr(fullnamegx,seploc+1);
  177.     end;
  178.   return(gxname);
  179.   end
  180.  
  181.  
  182. gimmeext:
  183.   arg fullnamegx;
  184.     tempgx = reverse(fullnamegx);
  185.     lengx = length(fullnamegx);   /* get length of string */
  186.     slashdex = index(tempgx,'/'); /* first occurance of '/' from right */
  187.     colondex = index(tempgx,':');  /* first occurance of ':' from right */
  188.     seploc = 0; /* assumes current dir, no path supplied */
  189.     if slashdex ~= 0 then do /* we assume we are in a DIR */
  190.       seploc = (lengx - slashdex)+1;
  191.       end;
  192.     else do
  193.       if colondex ~= 0 then do /* we assume we are on a device */
  194.         seploc = (lengx - colondex)+1;
  195.         end;
  196.       end;
  197.   extpos = lastpos(fullnamegx,'.');
  198.   if extpos > seploc then do
  199.     gxext = substr(fullnamegx,extpos+1);
  200.     end
  201.   else do
  202.     gxext = '';
  203.     end
  204.   return(gxext);
  205.   end
  206.  
  207.  
  208.